home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE08 / DATADICT / DICTCTRL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-11-06  |  7.6 KB  |  249 lines
  1. unit Dictctrl;
  2.  
  3. interface
  4. uses
  5.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  6.   Forms, Dialogs, DB, DBTables, inifiles, grids;
  7. const
  8.     FieldTypeStr : array[ftunknown..ftgraphic] of string[8] =
  9.       ('Unknown', 'String', 'Smallint', 'Integer', 'Word',
  10.        'Boolean', 'Float', 'Currency', 'BCD', 'Date', 'Time',
  11.        'DateTime', 'Bytes', 'VarBytes', 'Blob', 'Memo', 'Graphic');
  12.     FieldTypeLtr : array[ftunknown..ftgraphic] of string[1] =
  13.       ('U', 'S', 'I', 'N', 'W',
  14.        'L', 'F', 'C', 'B', 'D', 'T',
  15.        'A', 'Y', 'V', 'O', 'M', 'G');
  16.  
  17. type
  18.   DDValidationtype = (IsValidDD, DoesNotExist, ExistbutnotDD, NewDD, EmptyString );
  19.  
  20.   TDictCtrl = class(TComponent)
  21.     DictDB: TDatabase;
  22.     DictTable: TTable;
  23.     DictQuery: TQuery;
  24.     DictSource: TDataSource;
  25.   private
  26.     FiniFile : TiniFile;
  27.     FCtrlDictName : Tfilename; {fully qualified name}
  28.     FDictStatus : DDValidationType;
  29.     FDBSGGood : boolean;
  30.     FTableList : tStrings;
  31.     FDBSG : Tstringgrid;  {non-documentation part of dictionary}
  32.     FUpdated : Tdatetime; {info on current dictionary}
  33.     FDictsize : longint;
  34.     FnumRecords,
  35.     Fnumtables,
  36.     FnumFields : integer;
  37.     procedure ReadIniFile;
  38.     function getDictPath : tfilename;
  39.     procedure setDictPath( tmpstr : tfilename);
  40.     function getDictTable : tfilename;
  41.     procedure setDictTable (tmpstr : tfilename);
  42.   protected
  43.     Constructor create(Aowner : Tcomponent); override;
  44.     function OpenDD(const pathname, tablename : string): boolean;
  45.     function CheckOutDD(const Fulltablename : string): DDValidationtype;
  46.  
  47.     { Protected declarations }
  48.   public
  49.  
  50.     { Public declarations }
  51.   published
  52.     property DictStatus: DDValidationType read FDictStatus;
  53.     property FullDDName : tFilename read FCtrlDictName write FCtrlDictName;
  54.     property DictPathName: Tfilename read getDictPath;
  55.     property DictTableName: Tfilename read getDictTable;
  56.     property LastUpdate: tDateTime read Fupdated;
  57.     property DictSize: longint read FDictSize;
  58.     property NumRecords: integer read FNumRecords;
  59.     property numtables: integer read fNumtables;
  60.     property numfields: integer read fNumFields;
  61.     property DBSGExists : boolean read FDBSGGood;
  62.   end;
  63.  
  64.  
  65. procedure Register;
  66.  
  67. implementation
  68.  
  69. {$R *.DFM}
  70. uses utils;
  71. const
  72.    {indexes into DBSG columns}
  73.       tablename = 0;  {string 20}
  74.       tabletype = 1;  {string 20}
  75.       fieldname = 2;  {string[20];}
  76.       tag       = 3;  {string 20  tfield.tag}
  77.       scrprompt = 4;  {string[40]; {tfield.DisplayName}
  78.       scrformat = 5;  {string[80]; {tfield.DisplayText -- an editmask}
  79.       grdprompt = 6;  {string[10];}
  80.       grdwidth  = 7;  {smallint    {tfield.DisplayWidth}
  81.       fldtype   = 8;  {string[1];  {FieldTypeLtr}
  82.       fldlen    = 9;  {smallint    {tfield.size}
  83.       flddec    = 10; {smallint}
  84.       fldidx    = 11; {boolean;}
  85.       idxexp    = 12; {string;}
  86.       tab_order = 13; {integer;}
  87.       isrequired  = 14; {boolean;    {tfield.required}
  88.       defaultis   = 15; {string[80];}
  89.       editmaskis  = 16; {string[80]; {tfield.editMask}
  90.       minval    = 17; {ftfloat  tfield.minvalue}
  91.       maxval    = 18; {ftfloat  tfield.maxvalue}
  92.       vallist   = 19; {ftmemo   list of valid strings}
  93.       { define      documentation only
  94.         validvalue  documentation only
  95.         notes       documentation only}
  96.       hintTxt   = 20;  {string 120}
  97.       helpid    = 21;  {longint;}
  98.       {help, memo only used if helpid not null or 0}
  99.       haslink   = 22;  {boolean;}
  100.       srclinktbl = 23; {string[20];}
  101.       srclinkfld = 24; {string[20];}
  102.       iscalc     = 25; {boolean;}
  103.       formula    = 26; {memo only used if iscalc true}
  104. type
  105.    TDictCtrlStringGrid = TStringGrid;
  106. var
  107.    DBSG : TDictCtrlStringGrid;
  108.  
  109. Procedure TDictCtrl.ReadIniFile;
  110. begin
  111.   FIniFile := TiniFile.Create(appname+'.ini');
  112.   FCtrlDictName := FiniFile.ReadString('CtrlDict', 'current', appname+'.dbf');
  113.   FiniFile.free;
  114. end;
  115.  
  116. function TDictCtrl.getDictPath : tfilename;
  117. begin
  118.   result := extractFilePath(FCtrlDictName);
  119. end;
  120. procedure TDictCtrl.setDictPath( tmpstr : tfilename);
  121. begin
  122.   FCtrlDictName := tmpstr;
  123. end;
  124. function TDictCtrl.getDictTable : tfilename;
  125. begin
  126.   result := extractFileName(FCtrlDictName);
  127. end;
  128. procedure TDictCtrl.setDictTable (tmpstr : tfilename);
  129. begin
  130. end;
  131.  
  132. constructor TDictCtrl.create(Aowner : Tcomponent);
  133. begin
  134.   inherited create(Aowner);
  135.   readIniFile;
  136.   DictDB.Databasename := 'DataDictCtrlFormDB';
  137.   if CheckOutDD(FCtrlDictName) = IsValidDD
  138.     then begin
  139.       {first check it out}
  140.       {pull data into stringgrid?
  141.        or set up a permanent link/ query table
  142.        with data to modify current app
  143.        }
  144.       end
  145.     else begin
  146.       {some kind of message about no dictionary
  147.        present?
  148.        }
  149.       end;
  150. end;
  151.  
  152.  
  153. function TDictCtrl.openDD(const pathname, tablename : string): boolean;
  154. begin
  155.   try
  156.     DictDB.close;
  157.     DictDB.Params.clear;
  158.     DictDB.Params.Add('PATH='+PathName);
  159.     DictDB.open;
  160.     DictTable.DatabaseName:= DictDB.databasename;
  161.     DictTable.tablename := TableName;
  162.     DictTable.Active:= True;
  163.     DictSource.DataSet:= DictTable;
  164.     DictQuery.databaseName := DictDB.databasename;
  165.     DictQuery.dataSource := DictSource;
  166.     DictQuery.close;
  167.     DictQuery.sql.clear;
  168.     DictQuery.params.clear;
  169.     result := true;
  170.   except
  171.      on EdataBaseError do begin
  172.        screen.cursor := crDefault;
  173.        MessageDlg('Could not open '+pathname + ' '+tablename, mtInformation, [mbOK], 0);
  174.        result := false;
  175.        end;
  176.      end; {of exceptions}
  177. end;
  178.  
  179. function TDictCtrl.CheckOutDD(const Fulltablename : string): DDValidationtype;
  180. var
  181.     tablefound : boolean;
  182.     sqlstr,
  183.     thistable : string;
  184.     tablenum : integer;
  185.     FileInfo : TsearchRec;
  186.     tableField : tField;
  187.  
  188. begin
  189.   result := isValidDD;
  190.   fnumtables := 0;  fnumFields := 0; fDictsize := 0; fNumRecords := 0;
  191.   FTableList := tstringlist.create;
  192.   if fileExists(fulltablename)
  193.     then begin
  194.       FindFirst(fulltablename, faAnyfile, fileinfo);
  195.       FUpdated := fileDateToDateTime(Fileinfo.time);
  196.       fDictSize := FileInfo.size;
  197.       {not total size, should also get size of .dbt }
  198.       end
  199.     else begin
  200.       result := DoesNotExist;
  201.       exit;
  202.       end;
  203.   if openDD(DictPathName, DictTableName)
  204.     then begin
  205.       fnumrecords := DictTable.RecordCount;
  206.       sqlstr := 'SELECT * FROM '+DictTableName;
  207.       Dictquery.sql.add(sqlstr);
  208.       Dictquery.prepare;
  209.       Dictquery.open;
  210.       Dictquery.first;
  211.       { get tablenames in data dictionary, stick in M_tableList lines}
  212.       if DictQuery.findfield('TABLE_NAME') = nil
  213.         then begin
  214.            result := ExistButNotDD;
  215.            exit;
  216.            end;
  217.       ftableList.add(DictQuery.findfield('TABLE_NAME').text);  {get first one}
  218.       inc(fnumfields);
  219.       DictQuery.next;
  220.       while not DictQuery.eof do begin
  221.         tablefound := false;
  222.         thistable := DictQuery.findfield('TABLE_NAME').text;
  223.         inc(fnumFields);
  224.         for tablenum := 0 to ftablelist.count - 1 do
  225.           if ftableList.strings[tablenum] = thistable
  226.              then begin
  227.                 tablefound := true;
  228.                 break;
  229.                 end;
  230.           {done looking for thistable}
  231.         if not tablefound
  232.           then  ftablelist.add(thistable);
  233.         DictQuery.next;
  234.         end; {while searching for table names}
  235.     DictQuery.close;
  236.     end
  237.   else begin
  238.     result := ExistbutnotDD;
  239.     end;
  240. end;
  241.  
  242.  
  243. procedure Register;
  244. begin
  245.   RegisterComponents('Synature', [TDictCtrl]);
  246. end;
  247.  
  248. end.
  249.